Nothing
#' Write a reference data frame to gsi_sim format baseline and repunits file
#'
#' Note, this is only intended to work with integer-valued alleles, at the moment.
#' It was just written for testing and verifying that things are working correctly.
#'
#' @param ref reference data frame
#' @param gen_start_col column in which the genetic data start
#' @param baseout path to write the baseline file to. Required.
#' @param repout path to write the repunits file to. Required.
#' @export
#' @examples
#' # create a temp directory to put example outputs
#' dd <- tempdir()
#' basefile <- file.path(dd, "baseline.txt")
#' repunitsfile <- file.path(dd, "repunits.txt")
#'
#' # print those
#' basefile
#' repunitsfile
#'
#' # note that in practice you will probably want to specify
#' # your own filepaths...
#'
#' # run the function
#' write_gsi_sim_reference(alewife, 17, basefile, repunitsfile)
write_gsi_sim_reference <- function(ref, gen_start_col, baseout = "baseline.txt", repout = "repunits.txt") {
# first, write the reporting unit file
reps_list <- ref %>%
dplyr::count(repunit, collection) %>%
dplyr::filter(n > 0) %>%
dplyr::select(-n) %>%
dplyr::arrange(repunit, collection) %>%
base::split(.$repunit)
if (file.exists(repout)) file.remove(repout)
dump <- lapply(names(reps_list), function(x){
cat("REPUNIT", x, "\n", file = repout, append = TRUE)
cat(paste(" ", reps_list[[x]]$collection, "\n", sep = ""), sep = "", file = repout, append = TRUE)
})
# then write the full baseline
loccols <- names(ref)[gen_start_col:ncol(ref)]
ref[,loccols][is.na(ref[,loccols])] <- 0
ref_list <- split(ref, ref$collection)
cat(nrow(ref), (ncol(ref) - gen_start_col + 1) / 2, "\n", file = baseout) # number of indivs and loci on top line
locus_names <- names(ref)[seq(gen_start_col, ncol(ref), by = 2)]
cat(locus_names, sep = "\n", file = baseout, append = TRUE)
dump <- lapply(names(ref_list), function(x) {
cat("POP", x, "\n", file = baseout, append = TRUE)
write.table(ref_list[[x]][, c("indiv", loccols)], sep = " ", file = baseout, append = TRUE, quote = FALSE, row.names = FALSE, col.names = FALSE)
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.