R/mod_seq_alignment_fct.R

In teofiln/gene.editing.dash: VOR Gene Editing Dashboard

make_alignment_string <- function(.data, .n_bp) {
  ref_len <- nchar(.data$ReferenceSequence[[1]])

  if (ref_len < 30) {
    cut_points <- c(1, ref_len)
  } else {
    middle <- ref_len / 2
    cut_points <- switch(
      .n_bp,
      "10" = c(middle - 5, middle + 5),
      "20" = c(middle - 10, middle + 10),
      "30" = c(middle - 15, middle + 15)
    )
  }

  paste(
    stringr::str_sub(
      string = .data$ReferenceSequence,
      start = cut_points[[1]],
      end = cut_points[[2]]
    ),
    stringr::str_sub(
      string = .data$AlignmentString,
      start = cut_points[[1]],
      end = cut_points[[2]]
    ),
    stringr::str_sub(
      string = .data$AlignedSequence,
      start = cut_points[[1]],
      end = cut_points[[2]]
    ),
    "\n",
    sep = "\n"
  )
}

make_alignment_string_whole <- function(.data) {
  paste(
    .data$ReferenceSequence,
    .data$AlignmentString,
    .data$AlignedSequence,
    "\n",
    sep = "\n"
  )
}

reshape_alignment_data <-
  function(.data, .scale_by, .top_n, .n_bp) {

    group_by_pool <- c("ExperimentId",
                       "Group",
                       "TimePoint",
                       "Disease",
                       "Concentration",
                       "FlankSize",
                       "TargetId",
                       "SampleName",
                       "GrnaSequence")
    group_by_actual <- purrr::keep(group_by_pool, ~ . %in% colnames(.data))
    group_by_all <- c(group_by_actual,
                      "Alignment",
                      "NDeleted",
                      "NInserted",
                      "NMutated")


    for_select <- c("Group", "TimePoint", "Disease", "Concentration")
    for_select_final <- purrr::keep(for_select, ~ . %in% colnames(.data))
    final_select_order <- c(
      "ExperimentId",
      for_select_final,
      "TargetId",
      "FlankSize",
      "GrnaSequence",
      "Alignment",
      "NDeleted",
      "NInserted",
      "NMutated"
    )

    .data %>%
      dplyr::mutate(Alignment = make_alignment_string(.data, .n_bp)) %>%
      dplyr::select(-AlignedSequence, -AlignmentString, -ReferenceSequence, -AnalysisType) %>%
      dplyr::group_by(!!!rlang::syms(group_by_actual)) %>%
      dplyr::slice_max(order_by = !!rlang::sym(.scale_by), with_ties = FALSE, n = .top_n) %>%
      dplyr::group_by(!!!rlang::syms(group_by_all)) %>%
      dplyr::summarise_at(.scale_by, function(x) round(mean(x, na.rm = TRUE), 2)) %>%
      dplyr::arrange(dplyr::desc(!!rlang::sym(.scale_by))) %>%
      tidyr::pivot_wider(
        id_cols = purrr::discard(group_by_all, ~ . == "SampleName"),
        names_from = SampleName,
        values_from = !!rlang::sym(.scale_by)
      ) %>%
      dplyr::ungroup() %>%
      dplyr::select(
        !!!rlang::syms(final_select_order),
        dplyr::everything()
      )
  }