# write a structure file from a tidy data frame
#' @name write_structure
#' @title Write a structure file from a tidy data frame
#' @description Write a structure file from a tidy data frame
#' Used internally in \href{https://github.com/thierrygosselin/radiator}{radiator}
#' and \href{https://github.com/thierrygosselin/assigner}{assigner}
#' and might be of interest for users.
#' @param data A tidy data frame object in the global environment or
#' a tidy data frame in wide or long format in the working directory.
#' \emph{How to get a tidy data frame ?}
#' Look into \pkg{radiator} \code{\link{tidy_genomic_data}}.
#' @inheritParams read_strata
#' @param filename (optional) The file name prefix for the structure file
#' written to the working directory. With default: \code{filename = NULL},
#' the date and time is appended to \code{radiator_structure_}.
#' @param ... other parameters passed to the function.
#' @return A structure file is saved to the working directory.
#' @export
#' @rdname write_structure
#' @references Pritchard JK, Stephens M, Donnelly P. (2000)
#' Inference of population structure using multilocus genotype data.
#' Genetics. Genetics Society of America. 155: 945–959.
#' @author Thierry Gosselin \email{thierrygosselin@@icloud.com}
write_structure <- function(
data,
pop.levels = NULL,
filename = NULL,
...
) {
# Checking for missing and/or default arguments ******************************
if (missing(data)) rlang::abort("Input file missing")
# Import data ---------------------------------------------------------------
data %<>% radiator::tidy_wide(data = .) %>%
dplyr::select(STRATA, INDIVIDUALS, MARKERS, GT)
# pop.levels -----------------------------------------------------------------
if (!is.null(pop.levels)) {
data %<>%
dplyr::mutate(
STRATA = factor(STRATA, levels = pop.levels, ordered = TRUE),
STRATA = droplevels(STRATA)
) %>%
dplyr::arrange(STRATA, INDIVIDUALS, MARKERS)
} else {
data %<>%
dplyr::mutate(STRATA = factor(STRATA)) %>%
dplyr::arrange(STRATA, INDIVIDUALS, MARKERS)
}
# Create a marker vector ------------------------------------------------
markers <- dplyr::distinct(.data = data, MARKERS) %>%
dplyr::arrange(MARKERS) %>%
purrr::flatten_chr(.)
# Structure format ----------------------------------------------------------------
data %<>%
radiator::separate_gt(x = ., gt = "GT", gather = TRUE, exclude = c("STRATA", "INDIVIDUALS", "MARKERS"), split.chunks = 1L) %>%
dplyr::mutate(
ALLELES = dplyr::recode(.x = ALLELES, "000" = "-9"),
ALLELES = as.integer(ALLELES)
) %>%
radiator::rad_wide(x = ., formula = "INDIVIDUALS + STRATA ~ MARKERS + ALLELES_GROUP", values_from = "ALLELES") %>%
dplyr::mutate(STRATA = as.integer(STRATA)) %>%
dplyr::arrange(STRATA, INDIVIDUALS)
# Write the file in structure format -----------------------------------------
# Filename
if (is.null(filename)) {
file.date <- format(Sys.time(), "%Y%m%d@%H%M")
filename <- stringi::stri_join("radiator_structure_", file.date, ".str")
} else {
filename <- stringi::stri_join(filename, ".str")
}
filename.connection <- file(filename, "w") # open the connection to the file
writeLines(text = stringi::stri_join(markers, sep = "\t", collapse = "\t"),
con = filename.connection, sep = "\n")
close(filename.connection) # close the connection
readr::write_tsv(x = data, file = filename, append = TRUE, col_names = FALSE)
} # end write_structure
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.