1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
nclass.all <- function(x, fun = median)
{
  fun(c(
    nclass.Sturges(x),
    nclass.scott(x),
    nclass.FD(x)
  ))
}

calc_bin_width <- function(x, ...)
{
  rangex <- range(x, na.rm = TRUE)
  (rangex[2] - rangex[1]) / nclass.all(x, ...)
}

StatPercentileX <- ggproto("StatPercentileX", Stat,
                           compute_group = function(data, scales, probs) {
                             percentiles <- quantile(data$x, probs=probs)
                             data.frame(xintercept = percentiles)
                           },
                           required_aes = c("x")
)

stat_percentile_x <- function(mapping = NULL, data = NULL, geom = "vline",
                              position = "identity", na.rm = FALSE,
                              show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPercentileX, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

StatPercentileXLabels <- ggproto("StatPercentileXLabels", Stat,
                                 compute_group = function(data, scales, probs) {
                                   percentiles <- quantile(data$x, probs=probs)
                                   data.frame(x=percentiles, y=Inf,
                                              label=paste0("p", probs*100, ": ",
                                                           scales::comma(round(10^percentiles, digits=1))))
                                 },
                                 required_aes = c("x")
)

stat_percentile_xlab <- function(mapping = NULL, data = NULL, geom = "text",
                                 position = "identity", na.rm = FALSE,
                                 show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPercentileXLabels, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

calc_bin_width <- function(x, ...)
{
  rangex <- range(x, na.rm = TRUE)
  (rangex[2] - rangex[1]) / nclass.all(x, ...)
}

get_ratio <- function(x = x, y = y, display = 4/3){
  ratio_display <- display
  ratio_values <- ((max(x) - min(x)))/((max(y) - min(y)))
  ratio_values/ratio_display
}

get_ratio_log10 <- function(x = x, y = y, display = 4/3){
  ratio_display <- display
  ratio_values <- (log10(max(x) - min(x)))/(log10(max(y) - min(y)))
  ratio_values/ratio_display
}


round_preserve_sum <- function(x, digits = 0) {
  up <- 10 ^ digits
  x <- x * up
  y <- floor(x)
  indices <- tail(order(x-y), round(sum(x)) - sum(y))
  y[indices] <- y[indices] + 1
  y / up
}

get_stats_aa <- function(X){

  #Total number of aas
  n_aas <- X$n_aa %>% sum()

  aa_summary <- X %>%
    select(cat, contains("_aa"), n_genes) %>%
    group_by(cat) %>%
    summarise(across(everything(), sum))

  k_aa <- aa_summary %>%
    filter(cat == "Known") %>%
    group_by(cat) %>%
    select(cat, contains("_aa")) %>%
    summarise(across(everything(), function(x)x/n_aas))
  unk_aa <- aa_summary %>%
    filter(cat == "Unknown") %>%
    group_by(cat) %>%
    select(cat, contains("_aa")) %>%
    summarise(across(everything(), function(x)x/n_aas))
  nc_aa <- aa_summary %>%
    filter(cat == "None") %>%
    group_by(cat) %>%
    select(cat, contains("_aa")) %>%
    summarise(across(everything(), function(x)x/n_aas))

  stats_prop <- bind_rows(k_aa, unk_aa, nc_aa) %>%
    bind_cols(aa_summary %>% select(n_genes) %>% mutate(n_genes = n_genes/sum(n_genes)))

  stats_prop_wide <- stats_prop %>%
    pivot_longer(-cat) %>%
    mutate(type = ifelse(name == "n_aa", "Total", "Pfam")) %>%
    group_by(type) %>%
    mutate(prop = round_preserve_sum(value, digits = 2)) %>%
    arrange(name)
  list(stats_prop = stats_prop, stats_prop_wide = stats_prop_wide)
}

plot_treemap_aa <- function(X){
  library(treemapify)
  X %>%
    mutate(p_pfam_not_covered_aa = pfam_not_covered_aa/n_aa,
           p_pfam_covered_aa = pfam_covered_aa/n_aa) %>%
    select(category_type, cat, pfam_not_covered_aa, pfam_covered_aa ) %>%
    pivot_longer(-contains("cat")) %>%
    group_by(cat, name) %>%
    summarise(value = sum(value)) %>%
    ggplot(aes(area = value, subgroup = cat, fill = name)) +
    geom_treemap(color = "white", size = 0 , alpha = 1) +
    geom_treemap_subgroup_text(place = "middle", colour = "black", grow = FALSE) +
    geom_treemap_subgroup_border(color = "white", size = 4) +
    scale_fill_manual(values = pfam_aa_coverage_colors) +
    theme_ipsum_rc() +
    theme(legend.position = "none")
}