Skip to content

Commit 5365e6c

Browse files
thierrygosselinthierrygosselin
committed
bug fix:
* write_structure: structure doesn't like spaces in id names... add removal of spaces in the file along in the clean function * filter_hwe: ggtern bug with ggplot2 v.3.0.0 remove temporarily the figure
1 parent 7695cb2 commit 5365e6c

File tree

4 files changed

+52
-48
lines changed

4 files changed

+52
-48
lines changed

‎R/clean.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -31,8 +31,8 @@ clean_markers_names <- function(x) {
3131
clean_ind_names <- function(x) {
3232
x <- stringi::stri_replace_all_fixed(
3333
str = as.character(x),
34-
pattern = c("_", ":"),
35-
replacement = c("-", "-"),
34+
pattern = c("_", ":", " "),
35+
replacement = c("-", "-", ""),
3636
vectorize_all = FALSE)
3737
}#End clean_ind_names
3838

‎R/filter_hwe.R

+33-31
Original file line numberDiff line numberDiff line change
@@ -628,37 +628,39 @@ filter_hwe <- function(
628628
dplyr::mutate(POP_ID = factor(POP_ID, pop.levels))
629629
parabola <- sample.size <- NULL
630630

631-
plot.tern <- ggtern::ggtern(
632-
data = data.sum,
633-
ggtern::aes(AA, AB, BB, color = GROUPINGS, size = MISSING_PROP)) +
634-
ggplot2::scale_color_manual(name = "Exact test mid p-value", values = group_colors) +
635-
ggplot2::scale_size_continuous(name = "Missing genotypes proportion") +
636-
ggtern::theme_rgbw() +
637-
ggplot2::geom_point(alpha = 0.4) +
638-
ggplot2::geom_line(data = hw.parabola, ggplot2::aes(x = AA, y = AB),
639-
linetype = 2, size = 0.6, colour = "black") +
640-
ggtern::theme_nogrid_minor() +
641-
ggtern::theme_nogrid_major() +
642-
ggplot2::labs(
643-
x = "AA", y = "AB", z = "BB",
644-
title = "Hardy-Weinberg Equilibrium ternary plots",
645-
subtitle = "genotypes frequencies shown for AA: REF/REF, AB: REF/ALT and BB: ALT/ALT"
646-
) +
647-
ggplot2::theme(
648-
plot.title = ggplot2::element_text(size = 12, family = "Helvetica", face = "bold", hjust = 0.5),
649-
plot.subtitle = ggplot2::element_text(size = 10, family = "Helvetica", hjust = 0.5)
650-
) +
651-
ggplot2::facet_wrap(~ POP_ID)
652-
# plot.tern
653-
ggtern::ggsave(
654-
limitsize = FALSE,
655-
plot = plot.tern,
656-
# filename = file.path(path.folder, "hwe.ternary.plots.read.depth.pdf"),
657-
filename = file.path(path.folder, "hwe.ternary.plots.missing.data.pdf"),
658-
width = n.pop * 5, height = n.pop * 4,
659-
dpi = 300, units = "cm", useDingbats = FALSE)
660-
hw.parabola <- NULL
661-
if (verbose) message("Plot written: hwe.ternary.plots.missing.data.pdf")
631+
# plot.tern <- ggtern::ggtern(
632+
# data = data.sum,
633+
# ggtern::aes(AA, AB, BB, color = GROUPINGS, size = MISSING_PROP)) +
634+
# ggplot2::scale_color_manual(name = "Exact test mid p-value", values = group_colors) +
635+
# ggplot2::scale_size_continuous(name = "Missing genotypes proportion") +
636+
# ggplot2::geom_point(alpha = 0.4) +
637+
# ggplot2::geom_line(data = hw.parabola, ggplot2::aes(x = AA, y = AB),
638+
# linetype = 2, size = 0.6, colour = "black") +
639+
# ggplot2::labs(
640+
# x = "AA", y = "AB", z = "BB",
641+
# title = "Hardy-Weinberg Equilibrium ternary plots",
642+
# subtitle = "genotypes frequencies shown for AA: REF/REF, AB: REF/ALT and BB: ALT/ALT"
643+
# ) +
644+
# ggplot2::theme(
645+
# plot.title = ggplot2::element_text(size = 12, family = "Helvetica", face = "bold", hjust = 0.5),
646+
# plot.subtitle = ggplot2::element_text(size = 10, family = "Helvetica", hjust = 0.5)
647+
# ) +
648+
# ggtern::theme_rgbw() +
649+
# ggtern::theme_nogrid_minor() +
650+
# ggtern::theme_nogrid_major() +
651+
# ggplot2::facet_wrap(~ POP_ID)
652+
# # plot.tern
653+
# ggtern::ggsave(
654+
# limitsize = FALSE,
655+
# plot = plot.tern,
656+
# # filename = file.path(path.folder, "hwe.ternary.plots.read.depth.pdf"),
657+
# filename = file.path(path.folder, "hwe.ternary.plots.missing.data.pdf"),
658+
# width = n.pop * 5, height = n.pop * 4,
659+
# dpi = 300, units = "cm", useDingbats = FALSE)
660+
# hw.parabola <- NULL
661+
# if (verbose) message("Plot written: hwe.ternary.plots.missing.data.pdf")
662+
663+
plot.tern <- "temporarily out of order"
662664

663665
# Manhattan plot -------------------------------------------------------------
664666
data.sum.man <- dplyr::mutate(data.sum, X = "x") %>% dplyr::filter(MID_P_VALUE < 0.05)

‎R/write_structure.R

+15-13
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,6 @@
1212
#' \emph{How to get a tidy data frame ?}
1313
#' Look into \pkg{radiator} \code{\link{tidy_genomic_data}}.
1414

15-
1615
#' @param pop.levels (optional, string) A character string with your populations ordered.
1716
#' Default: \code{pop.levels = NULL}.
1817

@@ -24,7 +23,6 @@
2423
#' structure file.
2524
#' Default: \code{markers.line = TRUE}.
2625

27-
2826
#' @param filename (optional) The file name prefix for the structure file
2927
#' written to the working directory. With default: \code{filename = NULL},
3028
#' the date and time is appended to \code{radiator_structure_}.
@@ -61,39 +59,43 @@ write_structure <- function(
6159

6260
# Import data ---------------------------------------------------------------
6361
if (is.vector(data)) {
64-
input <- radiator::tidy_wide(data = data, import.metadata = FALSE)
62+
data <- radiator::tidy_wide(data = data, import.metadata = FALSE)
6563
} else {
66-
input <- data
64+
data$INDIVIDUALS <- clean_ind_names(data$INDIVIDUALS)
65+
data$POP_ID <- clean_pop_names(data$POP_ID)
66+
data$MARKERS <- clean_markers_names(data$MARKERS)
6767
}
6868

69+
70+
6971
# necessary steps to make sure we work with unique markers and not duplicated LOCUS
70-
if (tibble::has_name(input, "LOCUS") && !tibble::has_name(input, "MARKERS")) {
71-
input <- dplyr::rename(.data = input, MARKERS = LOCUS)
72+
if (tibble::has_name(data, "LOCUS") && !tibble::has_name(data, "MARKERS")) {
73+
data <- dplyr::rename(.data = data, MARKERS = LOCUS)
7274
}
7375

7476

75-
input <- dplyr::select(.data = input, POP_ID, INDIVIDUALS, MARKERS, GT)
77+
data <- dplyr::select(.data = data, POP_ID, INDIVIDUALS, MARKERS, GT)
7678

7779
# pop.levels -----------------------------------------------------------------
7880
if (!is.null(pop.levels)) {
79-
input <- dplyr::mutate(
80-
.data = input,
81+
data <- dplyr::mutate(
82+
.data = data,
8183
POP_ID = factor(POP_ID, levels = pop.levels, ordered = TRUE),
8284
POP_ID = droplevels(POP_ID)
8385
) %>%
8486
dplyr::arrange(POP_ID, INDIVIDUALS, MARKERS)
8587
} else {
86-
input <- dplyr::mutate(.data = input, POP_ID = factor(POP_ID)) %>%
88+
data <- dplyr::mutate(.data = data, POP_ID = factor(POP_ID)) %>%
8789
dplyr::arrange(POP_ID, INDIVIDUALS, MARKERS)
8890
}
8991

9092
# Create a marker vector ------------------------------------------------
91-
markers <- dplyr::distinct(.data = input, MARKERS) %>%
93+
markers <- dplyr::distinct(.data = data, MARKERS) %>%
9294
dplyr::arrange(MARKERS) %>%
9395
purrr::flatten_chr(.)
9496

9597
# Structure format ----------------------------------------------------------------
96-
input <- input %>%
98+
data <- data %>%
9799
tidyr::separate(col = GT, into = c("A1", "A2"), sep = 3, extra = "drop", remove = TRUE) %>%
98100
tidyr::gather(data = ., key = ALLELES, value = GT, -c(POP_ID, INDIVIDUALS, MARKERS)) %>%
99101
dplyr::mutate(
@@ -120,5 +122,5 @@ write_structure <- function(
120122
writeLines(text = stringi::stri_join(markers, sep = "\t", collapse = "\t"),
121123
con = filename.connection, sep = "\n")
122124
close(filename.connection) # close the connection
123-
readr::write_tsv(x = input, path = filename, append = TRUE, col_names = FALSE)
125+
readr::write_tsv(x = data, path = filename, append = TRUE, col_names = FALSE)
124126
} # end write_structure

‎README.md

+2-2
Original file line numberDiff line numberDiff line change
@@ -8,8 +8,8 @@ state and is being actively
88
developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active)
99
[![DOI](https://zenodo.org/badge/14548/thierrygosselin/radiator.svg)](https://zenodo.org/badge/latestdoi/14548/thierrygosselin/radiator)
1010

11-
[![packageversion](https://img.shields.io/badge/Package%20version-0.0.12-orange.svg)](commits/master)
12-
[![Last-changedate](https://img.shields.io/badge/last%20change-2018--07--09-brightgreen.svg)](/commits/master)
11+
[![packageversion](https://img.shields.io/badge/Package%20version-0.0.13-orange.svg)](commits/master)
12+
[![Last-changedate](https://img.shields.io/badge/last%20change-2018--07--17-brightgreen.svg)](/commits/master)
1313

1414
------------------------------------------------------------------------
1515

0 commit comments

Comments
 (0)